home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue33 / clinic / RGroup.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-12-09  |  1.7 KB  |  86 lines
  1. unit RGroup;
  2.  
  3. interface
  4.  
  5. uses
  6.   Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, DBCtrls;
  8.  
  9. type
  10.   TNewRadioGroup = class(TRadioGroup)
  11.   private
  12.     FStreamedCursor: Boolean;
  13.   protected
  14.     procedure CMCursorChanged(var Msg: TMessage);
  15.       message cm_CursorChanged;
  16.     procedure Loaded; override;
  17.   end;
  18.  
  19.   TDBNewRadioGroup = class(TDBRadioGroup)
  20.   private
  21.     FStreamedCursor: Boolean;
  22.   protected
  23.     procedure CMCursorChanged(var Msg: TMessage);
  24.       message cm_CursorChanged;
  25.     procedure Loaded; override;
  26.   end;
  27.  
  28. procedure Register;
  29.  
  30. implementation
  31.  
  32. procedure SetRadioGroupCursor(RG: TCustomRadioGroup; Cur: TCursor);
  33. var
  34.   Loop: Integer;
  35. begin
  36.   with RG do
  37.     for Loop := 0 to ControlCount - 1 do
  38.       if Controls[Loop] is TRadioButton then
  39.         TRadioButton(Controls[Loop]).Cursor := Cur
  40. end;
  41.  
  42. procedure TNewRadioGroup.CMCursorChanged(var Msg: TMessage);
  43. begin
  44.   inherited;
  45.   if csReading in ComponentState then
  46.     FStreamedCursor := True
  47.   else
  48.     SetRadioGroupCursor(Self, Cursor)
  49. end;
  50.  
  51. procedure TNewRadioGroup.Loaded;
  52. begin
  53.   inherited Loaded;
  54.   if FStreamedCursor then
  55.   begin
  56.     FStreamedCursor := False;
  57.     Perform(cm_CursorChanged, 0, 0)
  58.   end
  59. end;
  60.  
  61. procedure TDBNewRadioGroup.CMCursorChanged(var Msg: TMessage);
  62. begin
  63.   inherited;
  64.   if csReading in ComponentState then
  65.     FStreamedCursor := True
  66.   else
  67.     SetRadioGroupCursor(Self, Cursor)
  68. end;
  69.  
  70. procedure TDBNewRadioGroup.Loaded;
  71. begin
  72.   inherited Loaded;
  73.   if FStreamedCursor then
  74.   begin
  75.     FStreamedCursor := False;
  76.     Perform(cm_CursorChanged, 0, 0)
  77.   end
  78. end;
  79.  
  80. procedure Register;
  81. begin
  82.   RegisterComponents('Clinic', [TNewRadioGroup, TDBNewRadioGroup]);
  83. end;
  84.  
  85. end.
  86.